(import
 (except (rnrs base) let-values)
 (only (guile)
       lambda* λ
       display
       simple-format)
 ;; pipes
 (ice-9 popen))


;; `path-as-string->list` is copied from GNU Guix. Some
;; comments added. See:
;; https://git.savannah.gnu.org/cgit/guix.git/tree/guix/build/utils.scm?id=c0bc08d82c73e464a419f213d5ae5545bc67e2bf#n573.
(define* (path-as-string->list path #:optional (separator #\:))
  (if separator
      (string-tokenize path
                       ;; Match everything except the
                       ;; separator.
                       (char-set-complement
                        (char-set separator)))
      ;; Otherwise simply return a list containing the path
      ;; to be sure to always return a list.
      (list path)))


;; `find-executable-on-path` is adapted from GNU Guix's
;; `which` procedure. See:
;; https://git.savannah.gnu.org/cgit/guix.git/tree/guix/build/utils.scm?id=c0bc08d82c73e464a419f213d5ae5545bc67e2bf#n617
(define (find-executable-on-path executable)
  "Return the complete file name for EXECUTABLE as found in
${PATH}, or #f if EXECUTABLE could not be found."
  ;; search-path is a procedure defined in GNU Guile
  (search-path
   ;; Check the PATH for the executable.
   (path-as-string->list (getenv "PATH"))
   executable))


(define find-pager
  (λ ()
    (or (getenv "PAGER")
        (find-executable-on-path "more")
        (find-executable-on-path "less"))))


;;; Now onto the actual matter of using open-pipe ...

(define open-output-pipe*
  (λ (command . args)
    (open-output-pipe
     (string-join (cons command args) " "))))


(define string-repeat
  (λ (str n)
    (define (iter port str n)
      (when (> n 0)
        (display str port)
        (iter port str (- n 1))))
    (call-with-output-string
      (λ (port)
        (iter port str n)))))


(define long-string
  (string-repeat "lines\n1\n2\n3\n" 100))


(define output-paginated
  (λ (message)
    (let ([pager-pipe
           ;; Execute the pager command in a subprocess with its
           ;; arguments and return an output pipe to the pager.
           (open-output-pipe* (find-pager)
                              ;; Here we assume, that the
                              ;; pager will support an
                              ;; argument "-4". This might
                              ;; not always be true.
                              "-4")])
      (display (simple-format #f "~a\n" message)
               pager-pipe)
      ;; Ultimately close pipe after being done with writing to
      ;; it.
      (close-pipe pager-pipe))))


(output-paginated long-string)


;;; Usage for example: PAGER=more guile -L . using-open-pipe.scm
